home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / b / b.lha / B / src / bint / b1val.c < prev    next >
Encoding:
C/C++ Source or Header  |  1988-11-24  |  11.3 KB  |  550 lines
  1. /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
  2.  
  3. /*
  4.   $Header: b1val.c,v 1.4 85/08/22 16:53:49 timo Exp $
  5. */
  6.  
  7. /* General operations for objects */
  8.  
  9. #include "b.h"
  10. #include "b0con.h"
  11. #include "b1obj.h"
  12. #include "b1mem.h"
  13. #ifndef INTEGRATION
  14. #include "b1btr.h"
  15. #include "b1val.h"
  16. #endif
  17. #include "b1tlt.h"
  18. #include "b2nod.h" /* for _Nbranches */
  19. #include "b3scr.h" /* TEMPORARY for at_nwl */
  20. #include "b1num.h" /* for ccopy, rrelease, grab, grab_num, grab_rat, grab_approx */
  21. #ifdef INTEGRATION
  22. #include "node.h"
  23. #endif INTEGRATION
  24.  
  25. #ifdef vax
  26. /* 4.2 BSD malloc already takes care of using a small number of sizes */
  27. #define Len len
  28. #else
  29. #define Len (len < 200 ? len : ((len-1)/8+1)*8)
  30. #endif
  31.  
  32. #define Hdrsize (sizeof(struct value)-sizeof(string))
  33. #define Tsize (sizeof(a_telita))
  34. #define Adj(s) (unsigned) (Hdrsize+(s))
  35. #define Unadj(s) (unsigned) ((s)-Hdrsize)
  36. #define NodOffset (sizeof(int) + 2*sizeof(intlet))
  37.  
  38. #define Grabber() {if(len>Maxintlet)syserr(MESS(1800, "big grabber"));}
  39. #define Regrabber() {if(len>Maxintlet)syserr(MESS(1801, "big regrabber"));}
  40.  
  41. /*************************** Grabbing ***********************************/
  42.  
  43. #ifdef NOT_USED
  44. long gr= 0;
  45.  
  46. Visible Procedure prgr() {at_nwl=No;printf(" gr:%ld",gr);gr=0;}
  47. #endif
  48.  
  49. Hidden unsigned
  50. getsyze(type, len, pnptrs)
  51.     literal type; intlet len; int *pnptrs;
  52. {
  53.     register unsigned syze= 0;
  54.     register int nptrs= 0;
  55.     switch (type) {
  56.     case Num:
  57.         if (len >= 0) syze= Len*sizeof(digit);       /* Integral */
  58.         else if (len == -1) {
  59. #ifdef EXT_RANGE
  60.             syze= 2*sizeof(double);           /* Approximate */
  61. #else
  62.             syze= sizeof(double);           /* Approximate */
  63. #endif
  64.         }
  65.         else { syze= 2*sizeof(value); nptrs= 2; }  /* Rational */
  66.         break;
  67.     case Ptn: len= _Nbranches(len);
  68.         syze= (len+2)*sizeof(value); nptrs= len; break;
  69.     case Com: syze= len*sizeof(value); nptrs= len; break;
  70.  
  71.     case Sim: syze= sizeof(simploc); nptrs= 1; break;
  72.     case Tri: syze= sizeof(trimloc); nptrs= 3; break;
  73.     case Tse: syze= sizeof(tbseloc); nptrs= 2; break;
  74.     case How: syze= sizeof(how); nptrs= 1; break;
  75.     case For: syze= sizeof(formal); nptrs= 1; /*uname!*/ break;
  76.     case Per: syze= sizeof(per); nptrs= 1; break;
  77.     case Fun:
  78.     case Prd: syze= sizeof(funprd); nptrs= 1; break;
  79.     case Ref: syze= sizeof(ref); nptrs= 1; break;
  80. #ifndef INTEGRATION
  81.     case Tex:
  82.     case ELT:
  83.     case Lis:
  84.     case Tab: syze= sizeof(value); nptrs= 1; break;
  85. #else
  86.     case Tex: syze= (len+1)*sizeof(char); break;
  87.     case ELT:
  88.     case Lis:
  89.     case Tab: syze = Len*sizeof(value); nptrs= len; break;
  90.     case Pat: syze= sizeof(struct path) - Hdrsize; nptrs= 2; break;
  91.     case Nod: syze= sizeof(struct node) - Hdrsize - sizeof(node)
  92.             + len*sizeof(node);
  93.           nptrs= len; break;
  94. #endif
  95.     default:
  96.         printf("\ngetsyze{%c}\n", type);
  97.         syserr(MESS(1803, "getsyze called with unknown type"));
  98.     }
  99.     if (pnptrs != NULL) *pnptrs= nptrs;
  100.     return syze;
  101. }
  102.  
  103. Hidden value
  104. grab(type, len)
  105.     literal type; intlet len;
  106. {
  107.     unsigned syze= getsyze(type, len, (int*)NULL);
  108.     value v;
  109.     Grabber();
  110.     v= (value) getmem(Adj(syze));
  111.     v->type= type; v->len= len; v->refcnt= 1;
  112. #ifdef NOT_USED
  113.  gr+=1;
  114. #endif
  115.     return v;
  116. }
  117.  
  118. #ifndef INTEGRATION
  119.  
  120. Visible value grab_tlt(type, it) literal type, it; { return grab(type, it); }
  121.  
  122. #else
  123.  
  124. Visible value grab_tex(len) intlet len; { return grab(Tex, len); }
  125.  
  126. Visible value grab_elt() { return grab(ELT, 0); }
  127.  
  128. Visible value grab_lis(len) intlet len; { return grab(Lis, len); }
  129.  
  130. Visible value grab_tab(len) intlet len; { return grab(Tab, len); }
  131.  
  132. #endif
  133.  
  134. Visible value
  135. grab_num(len)
  136.     register int len;
  137. {
  138.     integer v;
  139.     register int i;
  140.  
  141.     if (len > Maxintlet) {
  142.         error(MESS(1804, "exceptionally large number"));
  143.         return Vnil;
  144.     }
  145.     if (len < -Maxintlet) len = -2;
  146.     v = (integer) grab(Num, len);
  147.     for (i = Length(v)-1; i >= 0; --i) Digit(v, i) = 0;
  148.     return (value) v;
  149. }
  150.  
  151. Visible value grab_rat() { return grab(Num, -2); }
  152.  
  153. Visible value
  154. regrab_num(v, len)
  155.     value v; register int len;
  156. {
  157.     register unsigned syze;
  158.  
  159.     syze = Len * sizeof(digit);
  160.     uniql(&v);
  161.     regetmem((ptr*)&v, Adj(syze));
  162.     Length(v) = len;
  163.     return v;
  164. }
  165.  
  166. Visible value grab_com(len) intlet len; { return grab(Com, len); }
  167.  
  168. Visible value grab_ptn(len) intlet len; { return grab(Ptn, len); }
  169.  
  170. Visible value grab_sim() { return grab(Sim, 0); }
  171.  
  172. Visible value grab_tri() { return grab(Tri, 0); }
  173.  
  174. Visible value grab_tse() { return grab(Tse, 0); }
  175.  
  176. Visible value grab_how() { return grab(How, 0); }
  177.  
  178. Visible value grab_for() { return grab(For, 0); }
  179.  
  180. Visible value grab_per() { return grab(Per, 0); }
  181.  
  182. Visible value grab_fun() { return grab(Fun, 0); }
  183.  
  184. Visible value grab_prd() { return grab(Prd, 0); }
  185.  
  186. Visible value grab_ref() { return grab(Ref, 0); }
  187.  
  188. #ifdef INTEGRATION
  189.  
  190. /*
  191.  * Allocate a node with nch children.
  192.  */
  193.  
  194. Visible node
  195. grab_node(nch)
  196.     register int nch;
  197. {
  198.     register node n = (node) grab(Nod, nch);
  199.     register int i;
  200.  
  201.     n->n_marks = 0;
  202.     n->n_width = 0;
  203.     n->n_symbol = 0;
  204.     for (i = nch-1; i >= 0; --i)
  205.         n->n_child[i] = Nnil;
  206.     return n;
  207. }
  208.  
  209. /*
  210.  * Allocate a path.
  211.  */
  212.  
  213. Visible path
  214. grab_path()
  215. {
  216.     register path p = (path) grab(Pat, 0);
  217.  
  218.     p->p_parent = PATHnil;
  219.     p->p_tree = Nnil;
  220.     p->p_ichild = 0;
  221.     p->p_ycoord = 0;
  222.     p->p_xcoord = 0;
  223.     p->p_level = 0;
  224.     p->p_addmarks = 0;
  225.     p->p_delmarks = 0;
  226.     return p;
  227. }
  228.  
  229. #endif INTEGRATION
  230.  
  231.  
  232. /******************************* Copying and releasing *********************/
  233.  
  234. Visible value
  235. copy(v)
  236.     value v;
  237. {
  238.     if (IsSmallInt(v)) return v;
  239.     if (v != Vnil && v->refcnt < Maxrefcnt) (v->refcnt)++;
  240. #ifdef NOT_USED
  241.  gr+=1;
  242. #endif
  243.     return v;
  244. }
  245.  
  246. Visible Procedure
  247. release(v)
  248.     value v;
  249. {
  250. #ifdef IBMPC
  251.     literal *r;
  252. #else
  253.     intlet *r;
  254. #endif
  255.     if (IsSmallInt(v)) return;
  256.     if (v == Vnil) return;
  257.     r= &(v->refcnt);
  258.     if (*r == 0) syserr(MESS(1805, "releasing unreferenced value"));
  259.     if (bugs) {
  260.         printf("releasing: ");
  261.         if (Type(v) == Num) bugs= No;
  262.         wri(v,No,No,No); newline();
  263.         bugs= Yes;
  264.     }
  265.     if (*r < Maxrefcnt && --(*r) == 0) rrelease(v);
  266. #ifdef NOT_USED
  267.  gr-=1;
  268. #endif
  269. }
  270.  
  271. Hidden value
  272. ccopy(v)
  273.     value v;
  274. {
  275.     literal type= v->type; intlet len; value w;
  276.     int nptrs; unsigned syze; register string from, to, end;
  277.     register value p, *pp, *pend;
  278.     len= Length(v);
  279.     syze= getsyze(type, len, &nptrs);
  280.     Grabber();
  281.     w= (value) getmem(Adj(syze));
  282.     w->type= type; w->len= len; w->refcnt= 1;
  283.     from= Str(v); to= Str(w); end= to+syze;
  284.     while (to < end) *to++ = *from++;
  285.     pp= Ats(w);
  286. #ifdef INTEGRATION
  287.     if (type == Nod) pp= (value*) ((char*)pp + NodOffset);
  288. #endif
  289.     pend= pp+nptrs;
  290.     while (pp < pend) {
  291.         p= *pp++;
  292.         if (p != Vnil && !IsSmallInt(p) && Refcnt(p) < Maxrefcnt)
  293.             ++Refcnt(p);
  294.     }
  295.     return w;
  296. }
  297.  
  298. Visible Procedure
  299. uniql(ll)
  300.     value *ll;
  301. {
  302.     if (*ll != Vnil && !IsSmallInt(*ll) && (*ll)->refcnt > 1) {
  303.         value c= ccopy(*ll);
  304.         release(*ll);
  305.         *ll= c;
  306.     }
  307. }
  308.  
  309. Hidden Procedure
  310. rrelease(v)
  311.     value v;
  312. {
  313.     literal type= v->type; intlet len;
  314.     int nptrs; register value *pp, *pend;
  315.     len= Length(v);
  316. #ifndef INTEGRATION
  317.     switch (type) {
  318.     case Tex:
  319.     case Tab:
  320.     case Lis:
  321.     case ELT:
  322.         relbtree(Root(v), Itemtype(v));
  323.         break;
  324.     default:
  325. #endif
  326.         VOID getsyze(type, len, &nptrs);
  327.         pp= Ats(v);
  328. #ifdef INTEGRATION
  329.         if (type == Nod) pp= (value*) ((char*)pp + NodOffset);
  330. #endif
  331.         pend= pp+nptrs;
  332.         while (pp < pend) release(*pp++);
  333. #ifndef INTEGRATION
  334.     }
  335. #endif
  336.     v->type= '\0'; freemem((ptr) v);
  337. }
  338.  
  339. #ifdef INTEGRATION
  340.  
  341. Visible Procedure
  342. xtndtex(a, d)
  343.     value *a; intlet d;
  344. {
  345.     intlet len= Length(*a)+d;
  346.     Regrabber();
  347.     regetmem((ptr *) a, Adj((len+1)*sizeof(char)));
  348.     (*a)->len= len;
  349. }
  350.  
  351. Visible Procedure
  352. xtndlt(a, d)
  353.     value *a; intlet d;
  354. {
  355.     intlet len= Length(*a); intlet l1= Len, l2;
  356.     len+= d; l2= Len;
  357.     if (l1 != l2) {
  358.         Regrabber();
  359.         regetmem((ptr *) a, Adj(l2*sizeof(value)));
  360.     }
  361.     (*a)->len= len;
  362. }
  363.  
  364. /*
  365.  * Set an object's refcnt to infinity, so it will never be released.
  366.  */
  367.  
  368. Visible Procedure
  369. fix_refcnt(v)
  370.     register value v;
  371. {
  372.     register int i;
  373.     register node n;
  374.     register path p;
  375.  
  376.     Assert(v->refcnt > 0);
  377.     v->refcnt = Maxrefcnt;
  378.     switch (v->type) {
  379.     case Tex:
  380.         break;
  381.     case Nod:
  382.         n = (node)v;
  383.         for (i = v->len - 1; i >= 0; --i)
  384.             if (n->n_child[i])
  385.                 fix_refcnt((value)(n->n_child[i]));
  386.         break;
  387.     case Pat:
  388.         p = (path)v;
  389.         if (p->p_parent)
  390.             fix_refcnt((value)(p->p_parent));
  391.         if (p->p_tree)
  392.             fix_refcnt((value)(p->p_tree));
  393.         break;
  394.     default:
  395.         Abort();
  396.     }
  397. }
  398.  
  399. #endif INTEGRATION
  400.  
  401. #ifndef INTEGRATION
  402.  
  403. /*********************************************************************/
  404. /* grab, copy, release of btree(node)s
  405. /*********************************************************************/
  406.  
  407. Visible btreeptr
  408. grabbtreenode(flag, it)
  409.     literal flag; literal it;
  410. {
  411.     btreeptr pnode; unsigned syz;
  412.     static intlet isize[]= {
  413.         sizeof(itexnode), sizeof(ilisnode),
  414.         sizeof(itabnode), sizeof(itabnode)};
  415.     static intlet bsize[]= {
  416.         sizeof(btexnode), sizeof(blisnode),
  417.         sizeof(btabnode), sizeof(btabnode)};
  418.     switch (flag) {
  419.     case Inner:
  420.         syz= isize[it];
  421.         break;
  422.     case Bottom:
  423.         syz= bsize[it];
  424.         break;
  425.     case Irange:
  426.     case Crange:
  427.         syz = sizeof(rangenode);
  428.         break;
  429.     }
  430.     pnode = (btreeptr) getmem((unsigned) syz);
  431.     Refcnt(pnode) = 1;
  432.     Flag(pnode) = flag;
  433.     return(pnode);
  434. }
  435.  
  436. /* ----------------------------------------------------------------- */
  437.  
  438. Visible btreeptr copybtree(pnode) btreeptr pnode; {
  439.     if (pnode != Bnil && Refcnt(pnode) < Maxrefcnt) ++Refcnt(pnode);
  440.     return(pnode);
  441. }
  442.  
  443. Visible Procedure uniqlbtreenode(pptr, it) btreeptr *pptr; literal it; {
  444.     if (*pptr NE Bnil && Refcnt(*pptr) > 1) {
  445.         btreeptr qnode = *pptr;
  446.         *pptr = ccopybtreenode(*pptr, it);
  447.         relbtree(qnode, it);
  448.     }
  449. }
  450.  
  451. Visible btreeptr ccopybtreenode(pnode, it) btreeptr pnode; literal it; {
  452.     intlet limp;
  453.     btreeptr qnode;
  454.     intlet iw;
  455.     
  456.     iw = Itemwidth(it);
  457.     qnode = grabbtreenode(Flag(pnode), it);
  458.     Lim(qnode) = limp = Lim(pnode);
  459.     Size(qnode) = Size(pnode);
  460.     switch (Flag(qnode)) {
  461.     case Inner:
  462.         cpynitms(Piitm(qnode, 0, iw), Piitm(pnode, 0, iw), limp, it);
  463.         cpynptrs(&Ptr(qnode, 0), &Ptr(pnode, 0), limp+1);
  464.         break;
  465.      case Bottom:
  466.         cpynitms(Pbitm(qnode, 0, iw), Pbitm(pnode, 0, iw), limp, it);
  467.         break;
  468.     case Irange:
  469.     case Crange:
  470.         Lwbval(qnode) = copy(Lwbval(pnode));
  471.         Upbval(qnode) = copy(Upbval(pnode));
  472.         break;
  473.     default:
  474.         syserr(MESS(1808, "unknown flag in ccopybtreenode"));
  475.     }
  476.     return(qnode);
  477. }
  478.  
  479. /* make a new root (after the old ptr0 split) */
  480.  
  481. Visible btreeptr mknewroot(ptr0, pitm0, ptr1, it)
  482.     btreeptr ptr0, ptr1; itemptr pitm0; literal it;
  483. {
  484.     int r;
  485.     intlet iw = Itemwidth(it);
  486.     btreeptr qnode = grabbtreenode(Inner, it);
  487.     Ptr(qnode, 0) = ptr0;
  488.     movnitms(Piitm(qnode, 0, iw), pitm0, 1, iw);
  489.     Ptr(qnode, 1) = ptr1;
  490.     Lim(qnode) = 1;
  491.     r= Sincr(Size(ptr0));
  492.     Size(qnode) = Ssum(r, Size(ptr1));
  493.     return(qnode);
  494. }
  495.  
  496. /* ----------------------------------------------------------------- */
  497.  
  498. /* release btree */
  499.  
  500. Visible Procedure relbtree(pnode, it) btreeptr pnode; literal it; {
  501.     width iw;
  502.     
  503.     iw = Itemwidth(it);
  504.     if (pnode EQ Bnil)
  505.         return;
  506.     if (Refcnt(pnode) EQ 0) {
  507.         syserr(MESS(1809, "releasing unreferenced btreenode"));
  508.         return;
  509.     }
  510.     if (Refcnt(pnode) < Maxrefcnt && --Refcnt(pnode) EQ 0) {
  511.         intlet l;
  512.         switch (Flag(pnode)) {
  513.         case Inner:
  514.             for (l = 0; l < Lim(pnode); l++) {
  515.                 relbtree(Ptr(pnode, l), it);
  516.                 switch (it) {
  517.                 case Tt:
  518.                 case Kt:
  519.                     release(Ascval(Piitm(pnode, l, iw)));
  520.                 case Lt:
  521.                     release(Keyval(Piitm(pnode, l, iw)));
  522.                 }
  523.             }
  524.             relbtree(Ptr(pnode, l), it);
  525.             break;
  526.         case Bottom:
  527.             for (l = 0; l < Lim(pnode); l++) {
  528.                 switch (it) {
  529.                 case Tt:
  530.                 case Kt:
  531.                     release(Ascval(Pbitm(pnode, l, iw)));
  532.                 case Lt:
  533.                     release(Keyval(Pbitm(pnode, l, iw)));
  534.                 }
  535.             }
  536.             break;
  537.         case Irange:
  538.         case Crange:
  539.             release(Lwbval(pnode));
  540.             release(Upbval(pnode));
  541.             break;
  542.         default:
  543.             syserr(MESS(1810, "wrong flag in relbtree()"));
  544.         }
  545.         freemem((ptr) pnode);
  546.     }
  547. }
  548.  
  549. #endif !INTEGRATION
  550.